home *** CD-ROM | disk | FTP | other *** search
/ Video Toaster 4.3 / Video Toaster v4.3.iso / 4.2 / arexx / modeler / prims.lwm < prev    next >
Text File  |  1998-04-16  |  7KB  |  307 lines
  1. /* Platonic Solid Generator  CMD: Platonic Solids
  2.  *   originally by Tom Wilson, 1992
  3.  *
  4.  * This program generates the seven platonic solids: tetra, cube,
  5.  * octahedron, cubeoctahedron, icosahedron, dodecahedron, and
  6.  * icosidodecahedron.
  7.  *
  8.  * Objects are based on the magic square numbers -- two numbers such that
  9.  * x-1 = 1/x.  The various coordinates using these two numbers, 0, 1 and 2
  10.  * are the corners of all these solids.  Each solid is normalized so that
  11.  * its vertices lie on the unit sphere before scaling and translation.
  12.  */
  13.  
  14. sysnam = 'Platonic Solids'
  15. filnam = 'T:solid.state'
  16. version = 'Platonic Solids v1.0'
  17.  
  18. libadd = addlib("LWModelerARexx.port",0)
  19. MATHLIB="rexxmathlib.library"
  20. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  21.   IF ~addlib("rexxmathlib.library",0,-30,0) THEN DO
  22.       call notify(1,"!Can't find rexxmathlib.library")
  23.     exit
  24.     end
  25. solids = 'Tetrahedron Cube Octahedron Cubeoctahedron Icosahedron'
  26. solids = solids 'Dodecahedron Icosidodecahedron'
  27.  
  28. rad = 1.0
  29. cen = 0 0 0
  30. sel = 1
  31.  
  32. call req_begin sysnam
  33.  
  34. id_sel = req_addcontrol("Solid", 'cv', solids)
  35. id_rad = req_addcontrol("Radius", 'n', 1)
  36. id_cen = req_addcontrol("Center", 'v', 1)
  37.  
  38. call req_setval id_sel, sel
  39. call req_setval id_rad, rad, 1
  40. call req_setval id_cen, cen, 0
  41.  
  42. if (~req_post()) then do
  43.     call req_end
  44.     exit
  45. end
  46.  
  47. sel = req_getval(id_sel)
  48. rad = req_getval(id_rad)
  49. parse value req_getval(id_cen) with cx cy cz .
  50.  
  51. call req_end
  52.  
  53. mcl = (sqrt(5)+1)/2
  54. mcs = (sqrt(5)-1)/2
  55. call add_begin
  56. interpret 'call' word(solids,sel)
  57. call add_end
  58.  
  59. exit
  60.  
  61. /* The Solids.  Each has a kind of custom sub-program to generate it.
  62.  */
  63.  
  64. Tetrahedron:
  65.     scl = rad / sqrt(3)
  66.     call point 1.0, 1.0, 1.0
  67.     call point 1.0, -1.0, -1.0
  68.     call point -1.0, 1.0, -1.0
  69.     call point -1.0, -1.0, 1.0
  70.     call face 0 1 2
  71.     call face 3 1 0
  72.     call face 0 2 3
  73.     call face 3 2 1
  74.     return
  75.  
  76.  
  77. Cube:
  78.     scl = rad / sqrt(3)
  79.     call point 1.0, 1.0, 1.0
  80.     call point 1.0, 1.0, -1.0
  81.     call point 1.0, -1.0, -1.0
  82.     call point 1.0, -1.0, 1.0
  83.     call point -1.0, -1.0, 1.0
  84.     call point -1.0, 1.0, 1.0
  85.     call point -1.0, 1.0, -1.0
  86.     call point -1.0, -1.0, -1.0
  87.     call face 0 3 2 1
  88.     call face 0 5 4 3
  89.     call face 0 1 6 5
  90.     call face 1 2 7 6
  91.     call face 2 3 4 7
  92.     call face 4 5 6 7
  93.     return
  94.  
  95.  
  96. Octahedron:
  97.     scl = rad
  98.     call point 1.0, 0.0, 0.0
  99.     call point -1.0, 0.0, 0.0
  100.     call point 0.0, 1.0, 0.0
  101.     call point 0.0, -1.0, 0.0
  102.     call point 0.0, 0.0, 1.0
  103.     call point 0.0, 0.0, -1.0
  104.     call face 0 2 4
  105.     call face 0 5 2
  106.     call face 0 4 3
  107.     call face 0 3 5
  108.     call face 1 4 2
  109.     call face 1 2 5
  110.     call face 1 3 4
  111.     call face 1 5 3
  112.     return
  113.  
  114.  
  115. Cubeoctahedron:
  116.     scl = rad / sqrt(2)
  117.     call point 0.0, 1.0, 1.0
  118.     call point 0.0, -1.0, 1.0
  119.     call point 0.0, -1.0, -1.0
  120.     call point 0.0, 1.0, -1.0
  121.     call point 1.0, 0.0, 1.0
  122.     call point -1.0, 0.0, 1.0
  123.     call point -1.0, 0.0, -1.0
  124.     call point 1.0, 0.0, -1.0
  125.     call point 1.0, 1.0, 0.0
  126.     call point -1.0, 1.0, 0.0
  127.     call point -1.0, -1.0, 0.0
  128.     call point 1.0, -1.0, 0.0
  129.     call face 0 4 8
  130.     call face 0 9 5
  131.     call face 1 11 4
  132.     call face 1 5 10
  133.     call face 2 10 6
  134.     call face 2 7 11
  135.     call face 3 6 9
  136.     call face 3 8 7
  137.     call face 0 8 3 9
  138.     call face 0 5 1 4
  139.     call face 1 10 2 11
  140.     call face 2 6 3 7
  141.     call face 4 11 7 8
  142.     call face 5 9 6 10
  143.     return
  144.  
  145.  
  146. Icosahedron:
  147.     scl = rad / sqrt(mcl*mcl + 1)
  148.     call point 0.0, mcl, 1.0
  149.     call point 0.0, -mcl, 1.0
  150.     call point 0.0, mcl, -1.0
  151.     call point 0.0, -mcl, -1.0
  152.     call point 1.0, 0.0, mcl
  153.     call point -1.0, 0.0, mcl
  154.     call point 1.0, 0.0, -mcl
  155.     call point -1.0, 0.0, -mcl
  156.     call point mcl, 1.0, 0.0
  157.     call point -mcl, 1.0, 0.0
  158.     call point mcl, -1.0, 0.0
  159.     call point -mcl, -1.0, 0.0
  160.     call face 0 5 4
  161.     call face 0 4 8
  162.     call face 4 10 8
  163.     call face 1 10 4
  164.     call face 1 4 5
  165.     call face 1 5 11
  166.     call face 5 9 11
  167.     call face 0 9 5
  168.     call face 0 2 9
  169.     call face 0 8 2
  170.     call face 1 11 3
  171.     call face 1 3 10
  172.     call face 2 6 7
  173.     call face 2 8 6
  174.     call face 6 8 10
  175.     call face 3 6 10
  176.     call face 3 7 6
  177.     call face 3 11 7
  178.     call face 7 11 9
  179.     call face 2 7 9
  180.     return
  181.  
  182.  
  183. Dodecahedron:
  184.     scl = rad / sqrt(3)
  185.     call point 0.0, mcs, mcl
  186.     call point 0.0, -mcs, mcl
  187.     call point 0.0, -mcs, -mcl
  188.     call point 0.0, mcs, -mcl
  189.     call point mcl, 0.0, mcs
  190.     call point -mcl, 0.0, mcs
  191.     call point -mcl, 0.0, -mcs
  192.     call point mcl, 0.0, -mcs
  193.     call point mcs, mcl, 0.0
  194.     call point -mcs, mcl, 0.0
  195.     call point -mcs, -mcl, 0.0
  196.     call point mcs, -mcl, 0.0
  197.     call point 1.0, 1.0, 1.0
  198.     call point -1.0, 1.0, 1.0
  199.     call point -1.0, -1.0, 1.0
  200.     call point 1.0, -1.0, 1.0
  201.     call point 1.0, -1.0, -1.0
  202.     call point 1.0, 1.0, -1.0
  203.     call point -1.0, 1.0, -1.0
  204.     call point -1.0, -1.0, -1.0
  205.     call face 0 1 15 4 12
  206.     call face 0 12 8 9 13
  207.     call face 0 13 5 14 1
  208.     call face 1 14 10 11 15
  209.     call face 2 3 17 7 16
  210.     call face 2 16 11 10 19
  211.     call face 2 19 6 18 3
  212.     call face 3 18 9 8 17
  213.     call face 4 15 11 16 7
  214.     call face 4 7 17 8 12
  215.     call face 5 13 9 18 6
  216.     call face 5 6 19 10 14
  217.     return
  218.  
  219.  
  220. Icosidodecahedron:
  221.     scl = rad / 2.0
  222.     call point 2.0, 0.0, 0.0
  223.     call point -2.0, 0.0, 0.0
  224.     call point 0.0, 2.0, 0.0
  225.     call point 0.0, -2.0, 0.0
  226.     call point 0.0, 0.0, 2.0
  227.     call point 0.0, 0.0, -2.0
  228.     call point mcl, mcs, 1.0
  229.     call point mcl, mcs, -1.0
  230.     call point mcl, -mcs, 1.0
  231.     call point mcl, -mcs, -1.0
  232.     call point -mcl, mcs, 1.0
  233.     call point -mcl, mcs, -1.0
  234.     call point -mcl, -mcs, 1.0
  235.     call point -mcl, -mcs, -1.0
  236.     call point 1.0, mcl, mcs
  237.     call point 1.0, mcl, -mcs
  238.     call point 1.0, -mcl, mcs
  239.     call point 1.0, -mcl, -mcs
  240.     call point -1.0, mcl, mcs
  241.     call point -1.0, mcl, -mcs
  242.     call point -1.0, -mcl, mcs
  243.     call point -1.0, -mcl, -mcs
  244.     call point mcs, 1.0, mcl
  245.     call point mcs, 1.0, -mcl
  246.     call point mcs, -1.0, mcl
  247.     call point mcs, -1.0, -mcl
  248.     call point -mcs, 1.0, mcl
  249.     call point -mcs, 1.0, -mcl
  250.     call point -mcs, -1.0, mcl
  251.     call point -mcs, -1.0, -mcl
  252.     call face 0 7 15 14 6
  253.     call face 0 8 16 17 9
  254.     call face 1 10 18 19 11
  255.     call face 1 13 21 20 12
  256.     call face 2 18 26 22 14
  257.     call face 2 15 23 27 19
  258.     call face 3 16 24 28 20
  259.     call face 3 21 29 25 17
  260.     call face 4 24 8 6 22
  261.     call face 4 26 10 12 28
  262.     call face 5 23 7 9 25
  263.     call face 5 29 13 11 27
  264.     call face 0 6 8
  265.     call face 0 9 7
  266.     call face 1 12 10
  267.     call face 1 11 13
  268.     call face 2 14 15
  269.     call face 2 19 18
  270.     call face 3 17 16
  271.     call face 3 20 21
  272.     call face 4 22 26
  273.     call face 4 28 24
  274.     call face 5 27 23
  275.     call face 5 25 29
  276.     call face 6 14 22
  277.     call face 7 23 15
  278.     call face 8 24 16
  279.     call face 9 17 25
  280.     call face 10 26 18
  281.     call face 11 19 27
  282.     call face 12 20 28
  283.     call face 13 29 21
  284.     return
  285.  
  286.  
  287. /* Generate a point, scaling and translating as we go.
  288.  */
  289. Point:
  290.     arg x,y,z
  291.     call add_point x*scl+cx y*scl+cy z*scl+cz
  292.     return
  293.  
  294.  
  295. /* Generate a face, converting from the zero-based C indexing to the
  296.  * 1-based arexx index.
  297.  */
  298. Face:
  299.     arg plist
  300.     n = words(plist)
  301.     outl = ''
  302.     do i = 1 to n
  303.     outl = outl word(plist,i)+1
  304.     end i
  305.     call add_quad outl
  306.     return
  307.